//e#define __COMPILE_DEBUG__
#include <stdbool.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "zepto.h"
#include "internal.h"

// May be it is a goot idea to make separate eval/apply pair
// but it will complicate tail recursion as I don't want to
// use gcc tail and sibling calls optimization to remain
// portable.

struct zepto *mk_lambda(struct env *env, struct zepto *arg_list, struct zepto *body)
{
  struct zepto *res;
  struct zepto *tmp;

  res = zepto_alloc();

  // check that arg_list is well formed
  tmp = arg_list;
  if(tmp->type != ZEPTO_PAIR && tmp != NIL) {
    ERROR("Non-list as parameter list.\n");
  }

  if(body->type != ZEPTO_PAIR) {
    ERROR("Invalid body.\n");
  }
  
  while(1) {
    if(tmp->type == ZEPTO_SYMBOL || tmp->type == ZEPTO_NIL) {
      //first case above is for va_args like (lambda x (a b . c) body)
      break;
    }
    if(CAR(tmp)->type != ZEPTO_SYMBOL) {
      ERROR("Non-symbol parameter.");
    }
    tmp = CDR(tmp);
  }

  res->type = ZEPTO_CLOSURE;
  res->data.function = zepto_alloc_general(sizeof(struct function));
  res->data.function->code.closure.env = env;
  res->data.function->code.closure.body = body;
  res->data.function->code.closure.arg_list = arg_list;
  res->data.function->eval_data.arg_count = 0;
  res->data.function->eval_data.eval_mask = 0;
  res->data.function->eval_data.have_tail = IGNORE_TAIL;
  res->data.function->eval_data.eval_tail = EVAL_TAIL;

  return res;
}

// convert a list of expressions to list of
// evaluated expressions
static inline void eval_list(struct env *env, struct zepto *head, struct zepto **res)
{ 
  if(head->type == ZEPTO_NIL) {
    *res = NIL;
  } else {
    *res = zepto_alloc();
    (*res)->type = ZEPTO_PAIR;
    while(1) {
      CHECK_TYPE(head, ZEPTO_PAIR);
      CAR(*res) = eval(env, CAR(head));
      if(CDR(head)->type == ZEPTO_NIL) {
        CDR(*res) = NIL;
        break;
      }
      head = CDR(head);
      CDR(*res) = zepto_alloc();
      res = &CDR(*res);
      (*res)->type = ZEPTO_PAIR;
    }
  }
}

// Main evil resides here
// I tried to find balance between stack economy and code
// spaghettiness. Actually number of on-stack allocated pointers
// can be decreased by at least two but it can make mess.
struct zepto *eval(struct env *env, struct zepto *expr)
{
  struct zepto *args[2];
  struct zepto *function;
  struct zepto *tail;
  struct zepto *temp;
  struct env *new_env;  
  unsigned char i, builtin_num, arg_count,
    eval_mask, have_tail, eval_tail, cnt;
  
  struct zepto *res;

  // this label will be used for tail calls
  start:
  DEBUG("expression to eval:");
#ifdef __COMPILE_DEBUG__
  print_sexpr(expr);
#endif

  switch(expr->type) {
    case ZEPTO_SYMBOL:
      DEBUG("Evaluating symbol \"%s\".\n", expr->data.symbol);
      // lookup it;
      res = env_lookup(env, expr);
      if(!res) {
        ERROR("Symbol \"%s\" lookup failed.\n", expr->data.symbol);
      }
      DEBUG("Lookup OK.\n");
      break;
    case ZEPTO_PAIR:
      DEBUG("Evaluating pair");

      function = CAR(expr);
      
      if(function->type == ZEPTO_SYMBOL) {
        function = env_lookup(env, function);
        ASSERT(function != NULL);
      } else {
        DEBUG("CAR is function, eval it");
        function = eval(env, function);
        DEBUG("CAR evaluated");
      }
      tail = CDR(expr);

      arg_count = function->data.function->eval_data.arg_count;
      eval_mask = function->data.function->eval_data.eval_mask;
      have_tail = function->data.function->eval_data.have_tail;
      eval_tail = function->data.function->eval_data.eval_tail;
      
      builtin_num = (function->type == ZEPTO_CLOSURE) ?
        NOT_BUILTIN : (function->data.function->code.builtin.func_num);

      cnt = 1;
      for(i = 0; i < arg_count; i++) {
        DEBUG("Param eaten.");
        if(tail->type != ZEPTO_PAIR) {
          ERROR("Insufficient arguments.\n");
        }
        args[i] = CAR(tail);
        tail = CDR(tail);
        
        // evaluate arg if needed
        if(eval_mask & cnt) {
          DEBUG("Param is to be evaluated");
          args[i] = eval(env, args[i]);
          DEBUG("Param evaluated");
        }
        
        // next mask bit
        cnt *= 2;
      }
      
      // check tail
      DEBUG("Tail requirement: %d %d", have_tail, eval_tail);

      switch(have_tail) {
        case NO_TAIL:
          CHECK_TYPE(tail, ZEPTO_NIL);
          break;
        case HAVE_TAIL:
          CHECK_TYPE(tail, ZEPTO_PAIR);
          break;
        case IGNORE_TAIL:
          break;
        default:
          ERROR("Wrong tail option");
      }

      if(eval_tail == EVAL_TAIL) {
        eval_list(env, tail, &temp);
        tail = temp;
      }

      DEBUG("Builtin_Num : %d", builtin_num);
      
      switch(builtin_num) {
        case BUILTIN_FOREIGN:
          DEBUG("Foreign, %s", function->data.function->code.builtin.name);
          res = function->data.function->code.builtin.routine(env, args[0], args[1], tail);
          DEBUG("Foreign exec complete");
          break;
          
        case NOT_BUILTIN:
          // This is user-defined function, go apply it;
          DEBUG("Not builtin symbol");
          DEBUG("closure has type %d", function->type);
          CHECK_TYPE(function, ZEPTO_CLOSURE);
          
          temp = function->data.function->code.closure.arg_list;
          
          // create env frame
          new_env = env_create(function->data.function->code.closure.env);

          // bind parameters
          while(1) {
            DEBUG("one param");
            if(tail->type == ZEPTO_NIL && temp->type == ZEPTO_NIL) {
              // Both lists ended
              break;
            }
            if(temp->type == ZEPTO_SYMBOL) {
              DEBUG("Binding parameters tail");
              env_define(new_env, temp, tail);
              break;
            }
            CHECK_TYPE(SAFE_CAR(temp), ZEPTO_SYMBOL);
            // cur_elem - name of current symbol
            env_define(new_env, CAR(temp), SAFE_CAR(tail));
            DEBUG("Defined");
            
            tail = CDR(tail);
            temp = CDR(temp);
          }
          
          DEBUG("Parameters completed");
          tail = function->data.function->code.closure.body;
          env = new_env;
          goto eval_body;
          
        case COND:
          while(tail->type != ZEPTO_NIL) {
            // args[0] here play role of condition
            args[0] = (SAFE_CAR(tail));
            temp = eval(env, SAFE_CAR(args[0]));
            if(temp != FALSE) {
              DEBUG("TRUE clause");
              expr = SAFE_CAR(CDR(args[0]));
              goto start;
            }
            DEBUG("FALSE clause");
            tail = CDR(tail);
          }
          res = FALSE;
          break;
          
        case CONS:
          res = MK_CONS(args[0], args[1]);
          break;
          
        case DEFINE:
          DEBUG("Evaluating DEFINE");
          // There are two available syntax variants:
          // (define <symbol> <value>) and
          // (define (<function> [params]*) [statement]+)
          // latter case is defun-like
          if(args[0]->type == ZEPTO_PAIR) {
            DEBUG("DEFUN syntax");
            // defun case
            CHECK_TYPE(CAR(args[0]), ZEPTO_SYMBOL);
            temp = mk_lambda(env, CDR(args[0]), tail);
            env_define(env, CAR(args[0]), temp);
            res = TRUE;
            break;
          }
          CHECK_TYPE(tail, ZEPTO_PAIR);
          CHECK_TYPE(CDR(tail), ZEPTO_NIL);
          args[1] = eval(env, CAR(tail));
          // Fallthrough
        case SET:
          CHECK_TYPE(args[0], ZEPTO_SYMBOL);
          if(builtin_num == DEFINE) {
            env_define(env, args[0], args[1]);
          } else {
            env_set(env, args[0], args[1]);
          }
          res = args[0];
          break;
          
        case LAMBDA:
          res = mk_lambda(env, args[0], tail);
          break;
          
        case QUOTE:
          res = tail;
          break;
          
        case LET:
          new_env = env_create(env);
          // cycle though bindings
          while(args[0]->type != ZEPTO_NIL) {
            temp = SAFE_CAR(args[0]);
            CHECK_TYPE(SAFE_CAR(temp), ZEPTO_SYMBOL);
            env_define(new_env, CAR(temp), eval(env, SAFE_CAR(CDR(temp))));
            args[0] = CDR(args[0]);
          }
          env = new_env;
          goto eval_body;
          break;
          
        case BEGIN:
          CHECK_TYPE(tail, ZEPTO_PAIR);
          goto eval_body;
          break;
          
        case SYM_CAR:  // SYM_CAR and SYM_CDR are used to avoid
        case SYM_CDR:  // confusion with CAD and CDR macros.
          CHECK_TYPE(args[0], ZEPTO_PAIR);
          res = (builtin_num == SYM_CAR) ?
            CAR(args[0]) : CDR(args[0]);
          break;
          
        case SET_CAR:
          CHECK_TYPE(args[0], ZEPTO_PAIR);
          CAR(args[0]) = args[1];
          break;
          
        case SET_CDR:
          CHECK_TYPE(args[0], ZEPTO_PAIR);
          CDR(args[0]) = args[1];
          break;
          
        case LIST:
          res = tail;
          break;
          
        case ATOMP:
          res = ZEPTO_TO_BOOL(is_atom(args[0]));
          break;
          
        case NUMBERP:
          res = ZEPTO_TO_BOOL(is_number(args[0]));
          break;
          
        case PAIRP:
          res = ZEPTO_TO_BOOL(is_pair(args[0]));
          break;
          
        case NULLP:
          res = ZEPTO_TO_BOOL(is_null(args[0]));
          break;

        case AND:
        case OR:
          // or and if are similar
          // args[0] - is default value
          // args[1] - value that breaks interpretation
          if(builtin_num == AND) {
            args[0] = TRUE;
            args[1] = FALSE;
          } else {
            args[0] = FALSE;
            args[1] = TRUE;
          }
          res = args[0];
          if(tail == NIL) {
            break;
          }
          while(CDR(tail)->type != ZEPTO_NIL) {
            temp = eval(env, CAR(tail));
            if(temp == args[1]) {
              res = args[1];
              break;
            }
            tail = CDR(tail);
            CHECK_TYPE(tail, ZEPTO_PAIR);
          }
          if(res == args[1]) {
            break;
          }
          expr = CAR(tail);
          goto start;
          
        default:
          ERROR("Internal error: wrong evaluator builtin_num: %d.\n", builtin_num);
      }
      break;
    default:
      //self evaluating values fall here
      DEBUG("Self evaluated");
      res = expr;
      break;
  }

  DEBUG("Return value:");
#ifdef __COMPILE_DEBUG__
  print_sexpr(res);
  printf("\n");
#endif
  return res;
  
  eval_body:

  if(tail == NIL) {
    return NIL;
  }

  while(CDR(tail)->type != ZEPTO_NIL) {
    eval(env, CAR(tail));
    tail = CDR(tail);
    CHECK_TYPE(tail, ZEPTO_PAIR);
  }
  
  expr = CAR(tail);
  goto start;
}

//// -------- here new eval starts

/*
  enum label {
  eval_dispatch,
  ev_self_eval,
  ev_variable,
  ev_quoted,
  ev_lambda,
  ev_application,
  ev_appl_did_operator,
  ev_appl_operand_loop,
  ev_appl_accumulate_arg,
  ev_appl_last_arg,
  ev_appl_accum_last_arg,
  apply_dispatch,
  primitive_apply,
  compound_apply,
  ev_begin,
  ev_sequence,
  ev_sequence_continue,
  ev_sequence_last_exp,
  ev_if,
  ev_if_decide,
  ev_if_alternative,
  ev_if_consequent,
  ev_assignment,
};
*/

struct machine {
  struct zepto *exp;
  struct zepto *val;
  struct zepto *proc;
  struct zepto *unev;
  struct zepto *argl;
  struct env *env;
  void (*cont)(void);
  
  struct zepto *stack;
};

static struct machine machine;

static inline push(struct zepto

struct zepto *eval_ng(struct env *env, struct zepto *exp)
{
}
